home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
lisp
/
kcl
/
kcl.lha
/
cmpnew
/
cmpblock.c
< prev
next >
Wrap
C/C++ Source or Header
|
1987-06-04
|
16KB
|
639 lines
/* (C) Copyright Taiichi Yuasa and Masami Hagiya, 1984. All rights reserved. */
#include <cmpinclude.h>
#include "cmpblock.h"
init_cmpblock(start,size,data)char *start;int size;object data;
{ register object *base=vs_top;register object *sup=base+VM2;vs_check;
Cstart=start;Csize=size;Cdata=data;set_VV(VV,VM1,data);
(void)(putprop(VV[0],VV[1],VV[2]));
(void)(putprop(VV[0],VV[3],VV[4]));
(void)(putprop(VV[5],VV[6],VV[2]));
(void)(putprop(VV[5],VV[7],VV[4]));
(void)(putprop(VV[8],VV[9],VV[10]));
(void)(putprop(VV[8],Ct,VV[11]));
(void)(putprop(VV[8],VV[12],VV[13]));
(void)(putprop(VV[8],Cnil,VV[14]));
(void)(putprop(VV[8],Cnil,VV[15]));
(void)(putprop(VV[8],Cnil,VV[16]));
(void)(putprop(VV[8],Cnil,VV[17]));
MF(VV[18],L12,start,size,data);
(void)(putprop(VV[18],VV[19],VV[20]));
(void)(putprop(VV[18],VV[21],VV[22]));
(void)(remprop(VV[18],VV[23]));
(void)(remprop(VV[18],VV[24]));
(void)(putprop(VV[18],Cnil,VV[25]));
MF(VV[26],L19,start,size,data);
(void)(putprop(VV[26],VV[27],VV[20]));
(void)(putprop(VV[26],VV[28],VV[22]));
(void)(remprop(VV[26],VV[23]));
(void)(remprop(VV[26],VV[24]));
(void)(putprop(VV[26],Cnil,VV[25]));
MF(VV[29],L26,start,size,data);
(void)(putprop(VV[29],VV[30],VV[20]));
(void)(putprop(VV[29],VV[31],VV[22]));
(void)(remprop(VV[29],VV[23]));
(void)(remprop(VV[29],VV[24]));
(void)(putprop(VV[29],Cnil,VV[25]));
MF(VV[32],L33,start,size,data);
(void)(putprop(VV[32],VV[33],VV[20]));
(void)(putprop(VV[32],VV[34],VV[22]));
(void)(remprop(VV[32],VV[23]));
(void)(remprop(VV[32],VV[24]));
(void)(putprop(VV[32],Cnil,VV[25]));
MF(VV[35],L40,start,size,data);
(void)(putprop(VV[35],VV[36],VV[20]));
(void)(putprop(VV[35],VV[37],VV[22]));
(void)(remprop(VV[35],VV[23]));
(void)(remprop(VV[35],VV[24]));
(void)(putprop(VV[35],Cnil,VV[25]));
MF(VV[38],L47,start,size,data);
(void)(putprop(VV[38],VV[39],VV[20]));
(void)(putprop(VV[38],VV[40],VV[22]));
(void)(remprop(VV[38],VV[23]));
(void)(remprop(VV[38],VV[24]));
(void)(putprop(VV[38],Cnil,VV[25]));
MF(VV[41],L54,start,size,data);
(void)(putprop(VV[41],VV[42],VV[20]));
(void)(putprop(VV[41],VV[43],VV[22]));
(void)(remprop(VV[41],VV[23]));
(void)(remprop(VV[41],VV[24]));
(void)(putprop(VV[41],Cnil,VV[25]));
(void)(putprop(VV[8],VV[44],VV[45]));
MF(VV[71],L62,start,size,data);
(void)(putprop(VV[8],VV[46],VV[47]));
MF(VV[72],L64,start,size,data);
MF(VV[73],L65,start,size,data);
(void)(putprop(VV[8],Cnil,VV[48]));
VV[49]->s.s_stype=(short)stp_special;
if(VV[49]->s.s_dbind == OBJNULL){
VV[49]->s.s_dbind = Cnil;}
MF(VV[1],L68,start,size,data);
MF(VV[3],L69,start,size,data);
MF(VV[74],L70,start,size,data);
MF(VV[75],L71,start,size,data);
MF(VV[76],L72,start,size,data);
MF(VV[6],L73,start,size,data);
MF(VV[7],L74,start,size,data);
MF(VV[77],L75,start,size,data);
MF(VV[78],L76,start,size,data);
MF(VV[79],L77,start,size,data);
vs_top=vs_base=base;
}
/* function definition for BLK-NAME */
static L12()
{ register object *base=vs_base;
register object *sup=base+VM3;
vs_reserve(VM3);
check_arg(1);
vs_top=sup;
TTL:;
base[1]= structure_ref(base[0],VV[8],0);
vs_top=(vs_base=base+1)+1;
return;
}
/* function definition for BLK-REF */
static L19()
{ register object *base=vs_base;
register object *sup=base+VM4;
vs_reserve(VM4);
check_arg(1);
vs_top=sup;
TTL:;
base[1]= structure_ref(base[0],VV[8],1);
vs_top=(vs_base=base+1)+1;
return;
}
/* function definition for BLK-REF-CLB */
static L26()
{ register object *base=vs_base;
register object *sup=base+VM5;
vs_reserve(VM5);
check_arg(1);
vs_top=sup;
TTL:;
base[1]= structure_ref(base[0],VV[8],2);
vs_top=(vs_base=base+1)+1;
return;
}
/* function definition for BLK-REF-CCB */
static L33()
{ register object *base=vs_base;
register object *sup=base+VM6;
vs_reserve(VM6);
check_arg(1);
vs_top=sup;
TTL:;
base[1]= structure_ref(base[0],VV[8],3);
vs_top=(vs_base=base+1)+1;
return;
}
/* function definition for BLK-EXIT */
static L40()
{ register object *base=vs_base;
register object *sup=base+VM7;
vs_reserve(VM7);
check_arg(1);
vs_top=sup;
TTL:;
base[1]= structure_ref(base[0],VV[8],4);
vs_top=(vs_base=base+1)+1;
return;
}
/* function definition for BLK-VALUE-TO-GO */
static L47()
{ register object *base=vs_base;
register object *sup=base+VM8;
vs_reserve(VM8);
check_arg(1);
vs_top=sup;
TTL:;
base[1]= structure_ref(base[0],VV[8],5);
vs_top=(vs_base=base+1)+1;
return;
}
/* function definition for BLK-VAR */
static L54()
{ register object *base=vs_base;
register object *sup=base+VM9;
vs_reserve(VM9);
check_arg(1);
vs_top=sup;
TTL:;
base[1]= structure_ref(base[0],VV[8],6);
vs_top=(vs_base=base+1)+1;
return;
}
/* function definition for MAKE-BLK */
static L62()
{ register object *base=vs_base;
register object *sup=base+VM10;
vs_reserve(VM10);
parse_key(vs_base,FALSE,FALSE,7,VV[53],VV[54],VV[56],VV[55],VV[80],VV[81],VV[82]);
vs_top=sup;
base[14]= VV[8];
base[15]= base[0];
base[16]= base[1];
base[17]= base[2];
base[18]= base[3];
base[19]= base[4];
base[20]= base[5];
base[21]= base[6];
vs_top=(vs_base=base+14)+8;
siLmake_structure();
return;
}
/* function definition for COPY-BLK */
static L64()
{ register object *base=vs_base;
register object *sup=base+VM11;
vs_reserve(VM11);
check_arg(1);
vs_top=sup;
TTL:;
base[1]= base[0];
base[2]= VV[8];
symlispcall_no_event(VV[83],base+1,2);
return;
}
/* function definition for BLK-P */
static L65()
{ register object *base=vs_base;
register object *sup=base+VM12;
vs_reserve(VM12);
check_arg(1);
vs_top=sup;
TTL:;
base[1]= base[0];
vs_top=(vs_base=base+1)+1;
siLstructurep();
vs_top=sup;
if((vs_base[0])!=Cnil){
goto T69;}
base[1]= Cnil;
vs_top=(vs_base=base+1)+1;
return;
T69:;
base[2]= base[0];
vs_top=(vs_base=base+2)+1;
siLstructure_name();
vs_top=sup;
base[1]= vs_base[0];
T75:;
if((base[1])!=Cnil){
goto T76;}
base[2]= Cnil;
vs_top=(vs_base=base+2)+1;
return;
T76:;
if(!(base[1]==VV[8])){
goto T80;}
base[2]= Ct;
vs_top=(vs_base=base+2)+1;
return;
T80:;
base[1]= get(base[1],VV[14],Cnil);
goto T75;
}
/* function definition for C1BLOCK */
static L68()
{ register object *base=vs_base;
register object *sup=base+VM13;
vs_reserve(VM13);
bds_check;
check_arg(1);
vs_top=sup;
TTL:;
if(!(endp(base[0]))){
goto T87;}
base[1]= VV[0];
base[2]= VV[50];
base[3]= VV[51];
(void)simple_symlispcall_no_event(VV[84],base+1,3);
T87:;
if(type_of(car(base[0]))==t_symbol){
goto T93;}
base[1]= VV[52];
base[2]= car(base[0]);
(void)simple_symlispcall_no_event(VV[85],base+1,2);
T93:;
base[2]= VV[53];
base[3]= car(base[0]);
base[4]= VV[54];
base[5]= Cnil;
base[6]= VV[55];
base[7]= Cnil;
base[8]= VV[56];
base[9]= Cnil;
vs_top=(vs_base=base+2)+8;
L62();
vs_top=sup;
base[1]= vs_base[0];
bds_bind(VV[49],make_cons(base[1],symbol_value(VV[49])));
base[4]= cdr(base[0]);
base[3]= simple_symlispcall_no_event(VV[86],base+4,1);
if((structure_ref(base[1],VV[8],3))!=Cnil){
goto T110;}
if((structure_ref(base[1],VV[8],2))!=Cnil){
goto T110;}
if((structure_ref(base[1],VV[8],1))==Cnil){
goto T111;}
T110:;
base[5]= cadr(base[3]);
base[4]= simple_symlispcall_no_event(VV[87],base+5,1);
base[5]= list(4,VV[0],base[4],base[1],base[3]);
vs_top=(vs_base=base+5)+1;
bds_unwind1;
return;
T111:;
vs_top=(vs_base=base+3)+1;
bds_unwind1;
return;
}
/* function definition for C2BLOCK */
static L69()
{ register object *base=vs_base;
register object *sup=base+VM14;
vs_reserve(VM14);
check_arg(2);
vs_top=sup;
TTL:;
if((structure_ref(base[0],VV[8],3))==Cnil){
goto T120;}
base[2]= base[0];
base[3]= base[1];
vs_top=(vs_base=base+2)+2;
L72();
return;
T120:;
if((structure_ref(base[0],VV[8],2))==Cnil){
goto T125;}
base[2]= base[0];
base[3]= base[1];
vs_top=(vs_base=base+2)+2;
L71();
return;
T125:;
base[2]= base[0];
base[3]= base[1];
vs_top=(vs_base=base+2)+2;
L70();
return;
}
/* function definition for C2BLOCK-LOCAL */
static L70()
{ register object *base=vs_base;
register object *sup=base+VM15;
vs_reserve(VM15);
check_arg(2);
vs_top=sup;
TTL:;
structure_set(base[0],VV[8],4,symbol_value(VV[57]));
structure_set(base[0],VV[8],5,symbol_value(VV[58]));
base[2]= base[1];
symlispcall_no_event(VV[88],base+2,1);
return;
}
/* function definition for C2BLOCK-CLB */
static L71()
{ register object *base=vs_base;
register object *sup=base+VM16;
vs_reserve(VM16);
bds_check;
check_arg(2);
vs_top=sup;
TTL:;
bds_bind(VV[59],symbol_value(VV[59]));
structure_set(base[0],VV[8],4,symbol_value(VV[57]));
structure_set(base[0],VV[8],5,symbol_value(VV[58]));
base[3]= simple_symlispcall_no_event(VV[89],base+4,0);
structure_set(base[0],VV[8],2,base[3]);
princ_str("\n ",VV[60]);
base[3]= structure_ref(base[0],VV[8],2);
(void)simple_symlispcall_no_event(VV[90],base+3,1);
princ_str("=alloc_frame_id();",VV[60]);
princ_str("\n frs_push(FRS_CATCH,",VV[60]);
base[3]= structure_ref(base[0],VV[8],2);
(void)simple_symlispcall_no_event(VV[90],base+3,1);
princ_str(");",VV[60]);
princ_str("\n if(nlj_active)",VV[60]);
princ_str("\n {nlj_active=FALSE;frs_pop();",VV[60]);
base[3]= VV[61];
base[4]= VV[62];
(void)simple_symlispcall_no_event(VV[91],base+3,2);
princ_char(125,VV[60]);
princ_str("\n else{",VV[60]);
base[3]= make_cons(VV[64],symbol_value(VV[63]));
bds_bind(VV[63],base[3]);
base[4]= base[1];
base[5]= simple_symlispcall_no_event(VV[88],base+4,1);
bds_unwind1;
princ_str("\n }",VV[60]);
base[3]= Cnil;
vs_top=(vs_base=base+3)+1;
bds_unwind1;
return;
}
/* function definition for C2BLOCK-CCB */
static L72()
{ register object *base=vs_base;
register object *sup=base+VM17;
vs_reserve(VM17);
bds_check;
check_arg(2);
vs_top=sup;
TTL:;
bds_bind(VV[59],symbol_value(VV[59]));
bds_bind(VV[65],symbol_value(VV[65]));
bds_bind(VV[66],symbol_value(VV[66]));
structure_set(base[0],VV[8],4,symbol_value(VV[57]));
structure_set(base[0],VV[8],5,symbol_value(VV[58]));
base[5]= simple_symlispcall_no_event(VV[89],base+6,0);
structure_set(base[0],VV[8],2,base[5]);
base[6]= structure_ref(base[0],VV[8],0);
base[5]= simple_symlispcall_no_event(VV[92],base+6,1);
structure_set(base[0],VV[8],6,base[5]);
princ_str("\n ",VV[60]);
base[5]= structure_ref(base[0],VV[8],2);
(void)simple_symlispcall_no_event(VV[90],base+5,1);
princ_str("=alloc_frame_id();",VV[60]);
princ_str("\n ",VV[60]);
base[5]= structure_ref(base[0],VV[8],2);
(void)simple_symlispcall_no_event(VV[90],base+5,1);
princ_str("=MMcons(",VV[60]);
base[5]= structure_ref(base[0],VV[8],2);
(void)simple_symlispcall_no_event(VV[90],base+5,1);
princ_char(44,VV[60]);
(void)simple_symlispcall_no_event(VV[93],base+5,0);
princ_str(");",VV[60]);
base[5]= structure_ref(base[0],VV[8],2);
(void)simple_symlispcall_no_event(VV[94],base+5,1);
base[5]= simple_symlispcall_no_event(VV[95],base+6,0);
structure_set(base[0],VV[8],3,base[5]);
princ_str("\n frs_push(FRS_CATCH,",VV[60]);
base[5]= structure_ref(base[0],VV[8],2);
(void)simple_symlispcall_no_event(VV[96],base+5,1);
princ_str(");",VV[60]);
princ_str("\n if(nlj_active)",VV[60]);
princ_str("\n {nlj_active=FALSE;frs_pop();",VV[60]);
base[5]= VV[61];
base[6]= VV[62];
(void)simple_symlispcall_no_event(VV[91],base+5,2);
princ_char(125,VV[60]);
princ_str("\n else{",VV[60]);
base[5]= make_cons(VV[64],symbol_value(VV[63]));
bds_bind(VV[63],base[5]);
base[6]= base[1];
base[7]= simple_symlispcall_no_event(VV[88],base+6,1);
bds_unwind1;
princ_str("\n }",VV[60]);
base[5]= Cnil;
vs_top=(vs_base=base+5)+1;
bds_unwind1;
bds_unwind1;
bds_unwind1;
return;
}
/* function definition for C1RETURN-FROM */
static L73()
{ register object *base=vs_base;
register object *sup=base+VM18;
vs_reserve(VM18);
check_arg(1);
vs_top=sup;
TTL:;
if(!(endp(base[0]))){
goto T215;}
base[1]= VV[5];
base[2]= VV[50];
base[3]= VV[51];
(void)simple_symlispcall_no_event(VV[84],base+1,3);
goto T213;
T215:;
if(endp(cdr(base[0]))){
goto T221;}
if(endp(cddr(base[0]))){
goto T221;}
base[1]= VV[5];
base[2]= VV[67];
base[3]= make_fixnum(length(base[0]));
(void)simple_symlispcall_no_event(VV[97],base+1,3);
goto T213;
T221:;
if(type_of(car(base[0]))==t_symbol){
goto T213;}
T213:;
{object V1;
object V2;
object V3;
base[1]= symbol_value(VV[49]);
V1= car(base[0]);
V2= Cnil;
V3= Cnil;
T236:;
if(!(endp(base[1]))){
goto T237;}
base[2]= VV[69];
base[3]= (V1);
symlispcall_no_event(VV[85],base+2,2);
return;
T237:;
{object V4= car(base[1]);
if((V4!= VV[98]))goto T244;
V2= Ct;
goto T243;
T244:;
if((V4!= VV[99]))goto T246;
V3= Ct;
goto T243;
T246:;
if(!(structure_ref(car(base[1]),VV[8],0)==(V1))){
goto T243;}
base[4]= cadr(base[0]);
base[2]= simple_symlispcall_no_event(VV[100],base+4,1);
base[3]= car(base[1]);
if(((V2))==Cnil){
goto T255;}
structure_set(base[3],VV[8],3,Ct);
goto T253;
T255:;
if(((V3))==Cnil){
goto T258;}
structure_set(base[3],VV[8],2,Ct);
goto T253;
T258:;
structure_set(base[3],VV[8],1,Ct);
T253:;
base[5]= cadr(base[2]);
base[4]= simple_symlispcall_no_event(VV[87],base+5,1);
base[5]= list(6,VV[5],base[4],base[3],(V3),(V2),base[2]);
vs_top=(vs_base=base+5)+1;
return;}
T243:;
base[1]= cdr(base[1]);
goto T236;}
}
/* function definition for C2RETURN-FROM */
static L74()
{ register object *base=vs_base;
register object *sup=base+VM19;
vs_reserve(VM19);
check_arg(4);
vs_top=sup;
TTL:;
if((base[2])==Cnil){
goto T266;}
base[4]= base[0];
base[5]= base[3];
vs_top=(vs_base=base+4)+2;
L77();
return;
T266:;
if((base[1])==Cnil){
goto T271;}
base[4]= base[0];
base[5]= base[3];
vs_top=(vs_base=base+4)+2;
L76();
return;
T271:;
base[4]= base[0];
base[5]= base[3];
vs_top=(vs_base=base+4)+2;
L75();
return;
}
/* function definition for C2RETURN-LOCAL */
static L75()
{ register object *base=vs_base;
register object *sup=base+VM20;
vs_reserve(VM20);
bds_check;
check_arg(2);
vs_top=sup;
TTL:;
base[2]= structure_ref(base[0],VV[8],5);
base[3]= structure_ref(base[0],VV[8],4);
bds_bind(VV[58],base[2]);
bds_bind(VV[57],base[3]);
base[4]= base[1];
symlispcall_no_event(VV[88],base+4,1);
bds_unwind1;
bds_unwind1;
return;
}
/* function definition for C2RETURN-CLB */
static L76()
{ register object *base=vs_base;
register object *sup=base+VM21;
vs_reserve(VM21);
bds_check;
check_arg(2);
vs_top=sup;
TTL:;
bds_bind(VV[58],VV[70]);
base[3]= base[1];
base[4]= simple_symlispcall_no_event(VV[101],base+3,1);
bds_unwind1;
princ_str("\n unwind(frs_sch(",VV[60]);
if((structure_ref(base[0],VV[8],3))==Cnil){
goto T286;}
base[2]= structure_ref(base[0],VV[8],2);
(void)simple_symlispcall_no_event(VV[96],base+2,1);
goto T284;
T286:;
base[2]= structure_ref(base[0],VV[8],2);
(void)simple_symlispcall_no_event(VV[90],base+2,1);
T284:;
princ_str("),Cnil);",VV[60]);
base[2]= Cnil;
vs_top=(vs_base=base+2)+1;
return;
}
/* function definition for C2RETURN-CCB */
static L77()
{ register object *base=vs_base;
register object *sup=base+VM22;
vs_reserve(VM22);
bds_check;
check_arg(2);
vs_top=sup;
TTL:;
princ_str("\n {frame_ptr fr;",VV[60]);
princ_str("\n fr=frs_sch(",VV[60]);
base[2]= structure_ref(base[0],VV[8],3);
(void)simple_symlispcall_no_event(VV[102],base+2,1);
princ_str(");",VV[60]);
princ_str("\n if(fr==NULL) FEerror(\"The block ~s is missing.\",1,VV[",VV[60]);
base[2]= structure_ref(base[0],VV[8],6);
(void)simple_symlispcall_no_event(VV[103],base+2,1);
princ_str("]);",VV[60]);
bds_bind(VV[58],VV[70]);
base[3]= base[1];
base[4]= simple_symlispcall_no_event(VV[101],base+3,1);
bds_unwind1;
princ_str("\n unwind(fr,Cnil);}",VV[60]);
base[2]= Cnil;
vs_top=(vs_base=base+2)+1;
return;
}